home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / JARexx / Textra.f < prev   
Encoding:
FORTH Source  |  1996-12-15  |  3.1 KB  |  135 lines
  1. \ This file compiles Specific TEXTRA interface words.  Author: Mike Haas
  2. \
  3. \ This program is placed into the public domain.
  4. \
  5. \                         IMPORTANT
  6. \                         =========
  7. \
  8. \ SEE THE NOTE BELOW ABOUT THE AREXX BUG FIX FOR JFORTH 3.0 & 3.1
  9. \
  10. \    NOTE: This program includes a workaround for a bug
  11. \          in the JForth ARexx code.  You can compile
  12. \          this file and it will work, but to really do this
  13. \          right, you should fix jrx:ARexxTools.f as follows:
  14. \          
  15. \          1. Open jrx:ARexxTools.f and locate the definition
  16. \             for RX.GET.MSG.  Add the following lines to it:
  17. \             
  18. \                 rx-result1 off
  19. \                 rx-result2 off
  20. \
  21. \    THE USE OF THIS PROGRAM REQUIRES TEXTRA 1.12 OR LATER.
  22. \
  23. \ ---------------------------------------------------------------
  24. \
  25. \ $TxOpen  ( filename -- , opens in textra )
  26. \
  27. \ TxOpen   ( -- , <filename> , opens in textra )
  28. \
  29. \ TxView   ( -- , <wordname> , found & displayed )
  30. \                 - works like FILE?
  31. \
  32. \ View     ( -- , <wordname , same as TxView )
  33. \
  34. \ 00000 08-jun-93 mdh     Initial version
  35.  
  36. include? task-Rexxclude.f  JRX:Rexxclude.f
  37.  
  38. ANEW TASK-Textra.F
  39.  
  40. decimal
  41.  
  42. : WorkAround  ( -- , this should be done by RX.GET.MSG )
  43.   rx-result1 off
  44.   rx-result2 off
  45. ;
  46.  
  47. 0 .if
  48. : rx.put.textra.launch  ( 0$ -- , will try to launch if nec )
  49. ;
  50. .then
  51.  
  52.  
  53. \ --------------------- OPEN SPECIFIED FILE
  54.  
  55. : |TxOpen$|  ( $filename -- 0 = error )
  56.   " OPENFILE "  pad $move
  57.   count pad $append
  58.   pad count >dos  dos0 rx.put.textra 0=
  59.   WorkAround
  60. ;
  61.  
  62. : TxOpen$  ( $filename -- )  |TxOpen$|  drop ;
  63.  
  64. : TxOpen  ( <command_line> -- , "string" )
  65.   eol word TxOpen$
  66. ;
  67.  
  68.  
  69. \ --------------------- DISPLAY JFORTH WORD  (FILE? to TEXTRA)
  70.  
  71. : NFA>FILE ( nfa -- addr cnt , file? with this NFA )
  72.     1 #nested !
  73.     \   >newline  dup id. 
  74.     BEGIN  dup nextname? ( thisnfa prevnfa/0 -- ) -dup
  75.          IF   swap drop dup nested?
  76.               IF    1 #nested +!
  77.               THEN
  78.               dup fileheader?  dup
  79.               IF   -1  #nested +!
  80.               THEN #nested @ 0= and
  81.          ELSE cr ." NFA>FILE$ : fileheaders not found!" quit
  82.          THEN
  83.     UNTIL
  84.     ( ."  was compiled from "  )
  85.     ( nfa -- )  dup c@ $ 1f and    ( nfa cnt -- )
  86.     4 -  ( nfa cnt-4 -- ) ( adjust out the locater text )
  87.     swap 5 + swap  ( adr cnt -- , of filename )
  88. ;
  89.  
  90. create &here  40 allot
  91. create &name  40 allot
  92.  
  93. : |TxView|  { fname fnamelen wordname -- }   \ 36 here$ &here  36 name$ &name -- }
  94.   \
  95.   &name off    fname fnamelen &name $append
  96.   &name |TxOpen$|
  97.   IF
  98.      " FIND "  pad $move
  99.      &here count pad $append
  100.      pad count >dos  dos0 rx.put.textra drop
  101.      WorkAround
  102.   THEN
  103. ;
  104.  
  105. : TxView$  ( $name -- )
  106.   dup &here $move  find
  107.   IF   ( pfa -- )  >name nfa>file   &here   |TxView|
  108.   ELSE $type ."  isn't in the selected vocabularies."
  109.   THEN
  110. ;
  111.  
  112. : TxView   ( -- )   ( eats: name )
  113.   bl word TxView$
  114. ;
  115.  
  116. >newline ." NOT RENAMING VIEW!  Use  'TxView' " cr
  117. \ : view TxView ;
  118.  
  119. \ THIS WORD TO BE USED BY TEXTRA ONLY!!!
  120.  
  121. : RETURNFILENAME  ( $name -- )
  122.     find
  123.     IF
  124.         ( -- pfa )  dup >name nfa>file CreateArgstring() ?dup
  125.         IF
  126.             rx-result2 !
  127.         THEN
  128.     THEN
  129.     drop  rx-result2 @ 0=
  130.     IF
  131.         0" NOTIFY NOT FOUND" rx.put.textra drop
  132.         Workaround
  133.     THEN
  134. ;
  135.